Precision Software Appli…tions Silver Collection 1/Precision Software Applications Silver Collection Volume One (PSM) (1993).iso/windows/games/tilecon.arj/TILECON.PAS

Pascal/Delphi Source File | 1992-07-03 | 5KB | 173 lines

Program TILECON;

(* Convertiert Mahjong-Tiles in Windows-Icons und umgekehrt *)
(* Aufruf ohne Parameter                                    *)
(*  Es erscheinen  Abfragen der Konvertierungsrichtung und  *)
(*  der Dateinamen.                                         *)
(*  Fehlermeldungen sollten nicht auftreten.                *)
(* Sprache: Turbo Pascal 6.0                                *)
(* Autor  : W. Ahls                                         *)
(* Das Programm ist frei benutzbar.                         *)

 uses dos,crt;

 const
  version = '1.0';
  IconHeader : array[1..126] of Byte =
           (0,0,1,0,   1,0,$20,$20,   $10,0,0,0,   0,0,$e8,2,
               0,0,$16,0, 0,0,$28,0,     0,0,$20,0,   0,0,$40,0,
        0,0,1,0,   4,0,0,0,       0,0,$80,2,   0,0,0,0,
        0,0,0,0,   0,0,0,0,       0,0,0,0,     0,0,0,0,
        0,0,0,0,   $80,0,0,$80,   0,0,0,$80,   $80,0,$80,0,
        0,0,$80,0, $80,0,$80,$80, 0,0,$80,80,  $80,0,$c0,$c0,
        $c0,0,0,0, $ff,0,0,$ff,   $ff,0,0,$ff, $ff,0,$ff,0,
        0,0,$ff,0, $ff,0,$ff,$ff, 0,0,$ff,$ff, $ff,0);
   (* Der Anhang an ein Icon besteht aus 128 Leerbytes *)


 var
  TileArray : array[1..40] of array[1..20] of Byte;
  Icon : record
          case Boolean of
           true  : (Buffer : array[1..766] of Byte);     (* Komplett *)
           false : (Prefix : array[1..126] of Byte;
                    Data   : array[1..32] of array[1..16] of Byte;
                    Suffix : array[1..128] of Byte);
          end;
  n : Word;
  z, s : byte;
  f : File;
  rc : Integer;
  result : Word;
  Aufgabe : Char;
  IDatei : String;
  ODatei : String;

 Function ConvertFarbe(Farbe : Byte) : Byte;
  var
   HNibble, LNibble : Byte;
  begin
   HNibble := Farbe shr 4;
   LNibble := Farbe and $f;
   case HNibble of
     1 : HNibble := 4;
     3 : HNibble := 6;
     4 : HNibble := 1;
     6 : HNibble := 3;
     7 : HNibble := 8;
     8 : HNibble := 7;
     9 : HNibble := 12;
    11 : HNibble := 14;
    12 : HNibble := 9;
    14 : HNibble := 11;
   end;
   case LNibble of
     1 : LNibble := 4;
     3 : LNibble := 6;
     4 : LNibble := 1;
     6 : LNibble := 3;
     7 : LNibble := 8;
     8 : LNibble := 7;
     9 : LNibble := 12;
    11 : LNibble := 14;
    12 : LNibble := 9;
    14 : LNibble := 11;
   end;
   ConvertFarbe := (HNibble shl 4) + LNibble;
  end;

 Begin
  WriteLn('TILE-ICON Converter ',Version);
  WriteLn;
  (* --- Eingabe der Aufgabe und der Dateinamen --- *)
  WriteLN(' ICON -> TILE = 1 ');
  WriteLn(' TILE -> ICON = 2  (Nur einzelne TILEs.)');
  WriteLn;
  Write('Gewünschte Konvertierung = ');
  repeat
   Aufgabe := readKey;
   if Aufgabe = #0 then Aufgabe := readkey;
   if Aufgabe = #27 then Halt;
  until (Aufgabe = '1') or (Aufgabe = '2');
  WriteLn(Aufgabe);
  if Aufgabe = '1'
   then Write('ICON-Datei (z.B.: TEST.ICO) : ')
   else Write('TILE-Datei (z.B.: TEST.TIL) : ');
  ReadLn(IDatei);
  if Aufgabe = '1'
   then Write('TILE-Datei (z.B.: TEST.TIL) : ')
   else Write('ICON-Datei (z.B.: TEST.ICO) : ');
  ReadLn(ODatei);
  (* --- Zu konvertierende Datei lesen --- *)
  Assign(f,IDatei);
  {$I-} Reset(f,1); {$I+}
  if IOResult <> 0 then
   begin
    Writeln('Fehler beim öffnen von ',IDatei,' !');
    Halt;
   end;
  {$F-}
  if Aufgabe = '1'
   then Blockread(f,Icon.Buffer,sizeOf(Icon.Buffer),result)
   else Blockread(f,TileArray,SizeOf(TileArray),result);
  {$F+}
  rc := IOResult;
  if rc <> 0 then
   begin
    WriteLn('DOS-Fehler ',rc,' beim lesen von ',IDatei,' !');
    Halt;
   end;
  if Aufgabe = '1'
   then begin
    if result <> SizeOf(Icon.Buffer) then
     begin
      WriteLn('Fehler beim lesen von ',IDatei,' !');
      Halt;
     end;
   end else begin
    if result <> SizeOf(TileArray) then
     begin
      WriteLn('Fehler beim lesen von ',IDatei,' !');
      Halt;
     end;
   end;
  {$F-} close(f); {$F+}
  rc := IOResult; (* vergiß es *)
  (* --- Daten übertragen und Farben umsetzen --- *)
  if Aufgabe = '1' then
   begin          (* ICON -> TILE *)
    (* Lösche TileArray *)
    FillChar(TileArray,sizeof(Tilearray),#0);
    (* Bild übertragen *)
    for z := 1 to 32 do
     for s := 1 to 16 do
      TileArray[z+2][s+3] := ConvertFarbe(Icon.Data[33-z][s]);
   end else begin (* TILE -> ICON *)
    (* Löschen des Puffers *)
    FillChar(ICON.Buffer,SizeOf(Icon.Buffer),#0);
    (* Füllen des Puffers *)
    move(IconHeader,Icon.Prefix,SizeOf(Icon.Prefix));
    (* Bild übertragen *)
    for z := 1 to 32 do
     for s := 1 to 16 do
      Icon.Data[33-z][s] := ConvertFarbe(TileArray[z+2][s+3]);
    (* Der Suffix bleibt leer *)
   end;
  (* --- Ergebnis speichern --- *)
  Assign(f,ODatei);
  {$I-} ReWrite(f,1); {$I+}
  if IOResult <> 0 then
   begin
    Writeln('Fehler beim öffnen von ',ODatei,' !');
    Halt;
   end;
  {$F-}
  if Aufgabe = '1'
   then BlockWrite(f,TileArray,SizeOf(TileArray),result)
   else BlockWrite(f,Icon.Buffer,sizeOf(Icon.Buffer),result);
  {$F+}
  rc := IOResult; (* vergiß es *)
  {$F-} close(f); {$F+}
  rc := IOResult; (* vergiß es *)
 End.